home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue47 / Alfresco / TstDate.dpr < prev   
Encoding:
Text File  |  1999-05-23  |  7.1 KB  |  227 lines

  1. program TstDate;
  2.  
  3. {$IFDEF Win32}
  4. {$APPTYPE CONSOLE}
  5. {$ENDIF}
  6.  
  7. uses
  8.   SysUtils,
  9.   {$ifdef windows}
  10.   WinTypes, WinProcs, WinCrt,
  11.   {$else}
  12.   Windows,
  13.   {$endif}
  14.   AADate in 'AADate.pas';
  15.  
  16. {$ifdef windows}
  17. type
  18.   DWORD = longint;
  19. {$endif}
  20.  
  21.  
  22. var
  23.   Dt, Dt2 : TaaDate;
  24.   Y, M, D, W : integer;
  25.   LastY, LastM, LastD : integer;
  26.   OK : boolean;
  27.   i  : integer;
  28.   StartTime, EndTime : DWORD;
  29.   TDT, TDT2 : TDateTime;
  30.   YY, MM, DD : word;
  31.   DOW : TaaDOW;
  32.   GregDate : longint;
  33.   MyHols : TaaHolidayList;
  34. begin
  35.   writeln('Testing...');
  36.   try
  37.     writeln('Full test');
  38.     LastY := 1799;
  39.     LastM := 12;
  40.     LastD := 31;
  41.     for Dt := 0 to 146096 do begin
  42.       aaDateToYMD(Dt, Y, M, D);
  43.       if (Y = LastY) and (M = LastM) and (D = LastD+1) then
  44.         OK := true
  45.       else if (D <> 1) then
  46.         OK := false
  47.       else if (Y = LastY) and (M = LastM+1) then
  48.         OK := true
  49.       else if (M <> 1) then
  50.         OK := false
  51.       else if (Y = LastY+1) then
  52.         OK := true
  53.       else
  54.         OK := false;
  55.       if not OK then begin
  56.         writeln('seq error at ', Y:5, M:3, D:3, ' Date: ', Dt);
  57.         readln;
  58.       end;
  59.       LastY := Y;
  60.       LastM := M;
  61.       LastD := D;
  62.  
  63.       Dt2 := aaYMDToDate(Y, M, D);
  64.       if (Dt2 <> Dt) then begin
  65.         writeln('error at ', Y:5, M:3, D:3, ' Date: ', Dt, ' <> ', Dt2);
  66.         readln;
  67.       end;
  68.     end;
  69.     writeln('End full test');
  70.  
  71.     writeln('today and the previous/next week');
  72.     writeln(ShortDateFormat, '   ', LongDateFormat);
  73.     writeln(aaDateToStr(aaToday, dfLotus));
  74.     writeln(aaDateToStr(aaToday, dfLotusDOW));
  75.     writeln(aaDateToStr(aaToday, dfWindows));
  76.     writeln(aaDateToStr(aaToday, dfDMY));
  77.     writeln(aaDateToStr(aaToday, dfMDY));
  78.     writeln(aaDateToStr(aaToday, dfYMD));
  79.     for DOW := aaSunday to aaSaturday do begin
  80.       writeln(aaDateToStr(aaNextDayOfWeek(aaToday, DOW), dfLotusDOW), ' ',
  81.               aaDateToStr(aaPrevDayOfWeek(aaToday, DOW), dfLotusDOW));
  82.     end;
  83.     readln;
  84.  
  85.     writeln('Dates from today: from -10 months to 10 months');
  86.     for i := -10 to 10 do begin
  87.       writeln(i:4, ' ', aaDateToStr(aaDateAddMonths(aaToday, i, false), dfLotusDOW));
  88.     end;
  89.     readln;
  90.     writeln('Dates from 31-Jul-1999: from -10 months to 10 months');
  91.     for i := -10 to 10 do begin
  92.       writeln(i:4, ' ', aaDateToStr(aaDateAddMonths(aaYMDToDate(1999, 7, 31), i, false), dfLotusDOW));
  93.     end;
  94.     readln;
  95.     writeln('Dates from 28-Feb-1999: from -10 months to 10 months, sticky');
  96.     for i := -10 to 10 do begin
  97.       writeln(i:4, ' ', aaDateToStr(aaDateAddMonths(aaYMDToDate(1999, 2, 28), i, true), dfLotusDOW));
  98.     end;
  99.     readln;
  100.     writeln('Dates from 28-Feb-1999: from -10 months to 10 months, nonsticky');
  101.     for i := -10 to 10 do begin
  102.       writeln(i:4, ' ', aaDateToStr(aaDateAddMonths(aaYMDToDate(1999, 2, 28), i, false), dfLotusDOW));
  103.     end;
  104.     readln;
  105.  
  106.     writeln('ISO date check...');
  107.     for Dt := 365 to 146096-365 do begin
  108.       aaDateToISODate(Dt, Y, W, D);
  109.       if (Dt <> aaISODateToDate(Y, W, D)) then begin
  110.         write('ISO error at ', aaDateToStr(Dt, dfLotusDOW));
  111.         readln;
  112.       end;
  113.     end;
  114.  
  115.     (*
  116.     writeln('nonsticky date month difference test');
  117.     for Dt := 73000 to 75000 do
  118.       for Dt2 := Dt to 75000 do begin
  119.         M := aaDateDiffInMonths(Dt, Dt2, false, D);
  120.         if (Dt2 <> (aaDateAddMonths(Dt, M, false) + D)) then begin
  121.           writeln('error in month arithmetic');
  122.           readln;
  123.         end;
  124.       end;
  125.     writeln('sticky date month difference test');
  126.     for Dt := 73000 to 75000 do
  127.       for Dt2 := Dt to 75000 do begin
  128.         M := aaDateDiffInMonths(Dt, Dt2, true, D);
  129.         if (Dt2 <> (aaDateAddMonths(Dt, M, true) + D)) then begin
  130.           writeln('error in month arithmetic');
  131.           readln;
  132.         end;
  133.       end;
  134.     writeln('done date month difference tests');
  135.     readln;
  136.     *)
  137.  
  138.     (*
  139.     writeln('Speed test');
  140.     StartTime := GetTickCount;
  141.     for i := 1 to 20 do begin
  142.       for Dt := 0 to 146096 do begin
  143.         aaDateToYMD(Dt, Y, M, D);
  144.         if aaYMDToDate(Y, M, D) <> Dt then
  145.           writeln('error in speed test');
  146.       end;
  147.     end;
  148.     writeln(GetTickCount-StartTime);
  149.  
  150.     StartTime := GetTickCount;
  151.     for i := 1 to 20 do begin
  152.       for Dt := 0 + 1000 to 146096 + 1000 do begin
  153.         TDT := Dt;
  154.         DecodeDate(TDT, YY, MM, DD);
  155.         if EncodeDate(YY, MM, DD) <> TDT then
  156.           writeln('error in speed test');
  157.       end;
  158.     end;
  159.     writeln(GetTickCount-StartTime);
  160.     *)
  161.  
  162.     writeln('Business day testing');
  163.     MyHols := TaaHolidayList.Create;
  164.     try
  165.       for Dt := aaYMDToDate(1990, 1, 31) downto aaYMDToDate(1990, 1, 1) do
  166.         MyHols.AddHoliday(Dt);
  167.       for Dt := aaYMDToDate(1999, 10, 31) downto aaYMDToDate(1999, 10, 1) do
  168.         MyHols.AddHoliday(Dt);
  169.       MyHols.AddHoliday(aaYMDToDate(1999, 6, 2));
  170.       MyHols.AddHoliday(aaYMDToDate(1999, 6, 3));
  171.       MyHols.AddHoliday(aaYMDToDate(1999, 5, 31));
  172.       for Dt := aaYMDToDate(1999, 5, 25) to aaYMDToDate(1999, 6, 8) do
  173.         writeln(aaDateToStr(Dt, dfLotusDOW), ' ',
  174.                 MyHols.IsBusinessDay(Dt));
  175.       readln;
  176.       writeln('next business day testing');
  177.       Dt := aaYMDToDate(1999, 5, 25);
  178.       Dt2 := aaYMDToDate(1999, 6, 8);
  179.       while Dt < Dt2 do begin
  180.         write(aaDateToStr(Dt, dfLotusDOW), ' -> ');
  181.         Dt := MyHols.NextBusinessDay(Dt);
  182.         writeln(aaDateToStr(Dt, dfLotusDOW));
  183.       end;
  184.       readln;
  185.       writeln('prev business day testing');
  186.       Dt := aaYMDToDate(1999, 5, 25);
  187.       Dt2 := aaYMDToDate(1999, 6, 8);
  188.       while Dt2 > Dt do begin
  189.         write(aaDateToStr(Dt2, dfLotusDOW), ' -> ');
  190.         Dt2 := MyHols.PrevBusinessDay(Dt2);
  191.         writeln(aaDateToStr(Dt2, dfLotusDOW));
  192.       end;
  193.       readln;
  194.       writeln('nearest business day testing - not same month');
  195.       for Dt := aaYMDToDate(1999, 5, 25) to aaYMDToDate(1999, 6, 8) do begin
  196.         write(aaDateToStr(Dt, dfLotusDOW), ' -> ');
  197.         Dt2 := MyHols.NearestBusinessDay(Dt, false);
  198.         writeln(aaDateToStr(Dt2, dfLotusDOW));
  199.       end;
  200.       readln;
  201.       writeln('nearest business day testing - same month');
  202.       for Dt := aaYMDToDate(1999, 5, 25) to aaYMDToDate(1999, 6, 8) do begin
  203.         write(aaDateToStr(Dt, dfLotusDOW), ' -> ');
  204.         Dt2 := MyHols.NearestBusinessDay(Dt, true);
  205.         writeln(aaDateToStr(Dt2, dfLotusDOW));
  206.       end;
  207.       readln;
  208.       writeln('other holiday testing');
  209.       writeln('..count prior to ClearBefore: ', MyHols.HolidayCount);
  210.       MyHols.ClearBefore(aaYMDToDate(1990, 2, 1));
  211.       writeln('..count after ClearBefore: ', MyHols.HolidayCount);
  212.       for Dt := aaYMDToDate(1999, 10, 1) to aaYMDToDate(1999, 10, 31) do
  213.         MyHols.DeleteHoliday(Dt);
  214.       writeln('..count after deletes: ', MyHols.HolidayCount);
  215.       for i := 0 to pred(MyHols.HolidayCount) do
  216.         writeln(aaDateToStr(MyHols[i], dfLotusDOW));
  217.     finally
  218.       MyHols.Free;
  219.     end;
  220.   except
  221.     on E:Exception do
  222.       writeln(E.Message);
  223.   end;
  224.   writeln('Done');
  225.   readln;
  226. end.
  227.